COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Destructive operation benchmark
C00004 ENDMK
C⊗;
;;; Destructive operation benchmark

(declare (fixsw t))

(defun destructive (n m)
       (let ((l (do ((i 10. (1- i))
		      (a () (push () a)))
		    ((= i 0) a))))
	    (do ((i n (1- i)))
		((= i 0))
            	(cond ((null (car l))
		       (do ((l l (cdr l)))
			   ((null l))
			   (or (car l) 
			       (rplaca l (ncons ())))
			    (nconc (car l)
				   (do ((j m (1- j))
					(a () (push () a)))
				       ((= j 0) a))))) 
			   (t
			    (do ((l1 l (cdr l1))
				 (l2 (cdr l) (cdr l2)))
				((null l2))
 				(rplacd (do ((j (// (length (car l2)) 2) (1- j))
					     (a (car l2) (cdr a)))
					    ((= j 0) a)
					    (rplaca a i))
					(let ((n (// (length (car l1)) 2)))
					     (cond ((= n 0) (rplaca l1 ())
							    (car l1))
						   (t 
						    (do ((j n (1- j))
							 (a (car l1) (cdr a)))
							((= j 1)
							 (prog1 (cdr a)
								(rplacd a ())))
							(rplaca a i))))))))))))

(include "timer.lsp")
(timer timit (destructive 600. 50.))